home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / print.arc / CPP1651.RPG next >
Encoding:
Text File  |  1991-12-04  |  5.0 KB  |  117 lines
  1.       /TITLE  Print a charcter string.
  2.       *       Program name - CPP1651
  3.       *       Command processing program for command PRINT.
  4.       *
  5.       *       This program will allow the use of printed
  6.       *       output in CL or via command entry.
  7.       *
  8.       *       Indicator 11 is used to control existance
  9.       *       of headings output.
  10.       *
  11.       /SPACE
  12.      FQPRINT  O   F     255     OV     PRINTER      KPRTCTLPRTCTL
  13.      IHDRPRM      DS
  14.      I                                    B  01  020FILLER
  15.      I                                       03  03 HDRCTL
  16.      I                                       04  04 HDRRPL
  17.      IHDR         DS                          8
  18.      I                                      001 255 HDRDTA
  19.      I                                      256 256 HDRSPB
  20.      I                                      257 257 HDRSPA
  21.      I                                      258 259 HDRSKB
  22.      I                                      260 261 HDRSKA
  23.      I                                      256 261 HDRLSC
  24.      IPRTCTL      DS
  25.      I                                       01  01 SPACEB
  26.      I                                       02  02 SPACEA
  27.      I                                       03  04 SKIPB
  28.      I                                       05  06 SKIPA
  29.      I                                       01  06 PRTLSC
  30.      I                                       07  090CURLIN
  31.      C           *ENTRY    PLIST
  32.      C                     PARM           PRTDTA255
  33.      C           SPACEA    PARM           SPA     1
  34.      C           SPACEB    PARM           SPB     1
  35.      C           SKIPA     PARM           SKA     2
  36.      C           SKIPB     PARM           SKB     2
  37.      C           INGOVF    PARM           INGOVF  1
  38.      C                     PARM           HDRPRM
  39.      C                     PARM           CLOSE   1
  40.       /SPACE
  41.       *   Check for headings indication.
  42.      C           HDRCTL    IFEQ '1'
  43.       *   If this is a heading, then set on the header switch
  44.      C                     MOVEL'1'       *IN11
  45.       *   If replace headings *YES, then
  46.      C           HDRRPL    IFEQ '1'
  47.       *   Zap the headings counter.
  48.      C                     Z-ADD1         HDRCNT  30
  49.      C                     ELSE
  50.       *   Else, increment the heading counter.
  51.      C                     ADD  1         HDRCNT
  52.      C                     END
  53.       *   Set the heading data structure to the correct ocurrence
  54.      C           HDRCNT    OCUR HDR
  55.       *   Move the printed data field, to the heading data structure
  56.      C                     MOVELPRTDTA    HDRDTA
  57.       *   Move the printer (heading) control codes to the data structure
  58.      C                     MOVELPRTLSC    HDRLSC
  59.      C                     END
  60.       /SPACE
  61.      C           HDRCTL    IFEQ '0'
  62.       *  If this is a normal printed line then continue.
  63.       /SPACE
  64.      C           *INOV     CASEQ'1'       OVRFLO           Overflow on?
  65.      C                     END
  66.       /SPACE
  67.       *   If first line, then test for headings.
  68.      C           DTLCNT    CASEQ0         OVRFLO           Print header
  69.      C                     END
  70.       /SPACE
  71.      C                     EXCPTPLINE                      Print line.
  72.       *   Increment the line counter.
  73.      C                     ADD  1         DTLCNT 150
  74.       /SPACE
  75.      C                     END
  76.       /SPACE
  77.      C           ENDPGM    TAG
  78.       /SPACE
  79.       *   Does the user want to close the printer file?
  80.      C           CLOSE     IFEQ '1'                        CLOSE(*YES)?
  81.       *   Terminate process.
  82.      C                     MOVE '1'       *INLR            End program.
  83.      C                     ELSE                            Else, exit and
  84.       *   Else, return and leave active.
  85.      C                     RETRN                           leave active.
  86.      C                     END
  87.       /SPACE
  88.      CSR         OVRFLO    BEGSR
  89.       *   Set off the overflow idicator.
  90.      C                     MOVE '0'       *INOV
  91.       *   Are there any headings?
  92.      C           *IN11     IFEQ '1'
  93.       *   Print out each heading line.
  94.      C           1         DO   HDRCNT    X       30
  95.       *   Set headings' data structure to X occurrance
  96.      C           X         OCUR HDR
  97.       *   Put the heading spacing control codes into
  98.       *   the printer control data structure.
  99.      C                     MOVELHDRLSC    PRTLSC
  100.       *   Print the headings
  101.      C                     EXCPTHLINE
  102.      C                     END
  103.      C                     ELSE
  104.       *   If no headings, then check if ignore overflow(*NO)
  105.      C           INGOVF    IFEQ '0'
  106.       *   If skip before is not specified, then force a SkipB(01)
  107.      C           SKIPB     ANDEQ*BLANKS
  108.      C                     MOVEL'01'      SKIPB
  109.      C                     END
  110.      C                     END
  111.       /SPACE
  112.      CSR         ENDOVR    ENDSR
  113.      OQPRINT  E                HLINE
  114.      O                         HDRDTA   255
  115.      OQPRINT  E                PLINE
  116.      O                         PRTDTA   255
  117.